home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: PD Unicornics
/
PD Unicornics-Graphs 01 (19xx)(Gartelmann, Peter)(DE)(PD)[h added AmigaBasic].zip
/
PD Unicornics-Graphs 01 (19xx)(Gartelmann, Peter)(DE)(PD)[h added AmigaBasic].adf
/
fractalmountain
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1988-12-31
|
4KB
|
198 lines
CLEAR 32767
DEFSNG a-z
DIM Lv(64,64)
DIM cmap$(31)
PRINT" Copyright 1987"
PRINT"Compute Publications, Inc."
PRINT" All Rights Reserved.":PRINT
RANDOMIZE
PRINT"Enter maximum variation (0-2) (1 is nice) ";:INPUT max
PRINT"Enter a filename to save picture under."
INPUT "(Saving at end is optional.) ";fiL$
FOR a = 1 TO 10
PRINT RND
NEXT
SCREEN 2,320,200,5,1
WINDOW 3,"Mountain",(0,0) - (311,186),28,2
FOR a = 0 TO 15
PALETTE a,a/15,a/25,a/50
PALETTE a+16,a/15,a/15,a/15
a$ = CHR$(a*17)
cmap$(a) = a$+CHR$(a*10.2)+CHR$(a*5.1)
cmap$(a+16) = a$+a$+a$
NEXT
PALETTE 16,0,0.25,0.5
cmap$(16) = CHR$(0)+CHR$(64)+CHR$(128)
COLOR 15
maxLv = 0
MakeMount:
FOR iter = 6 TO 1 STEP -1
sk = 2 ^ iter
hL = sk/2
PRINT"Doing Iteration";iter
Dotops:
PRINT"Tops & Bottoms ";
FOR y = 0 TO 64 STEP sk
FOR x = hL TO 64 STEP sk
ran = (RND-0.5)*max*sk
oLd = (Lv(x-hL,y) + Lv(x+hL,y))/2
Lv(x,y) = oLd + ran
NEXT x
NEXT y
Dobottoms:
PRINT "Sides ";
FOR x = 0 TO 64 STEP sk
FOR y = hL TO 64 STEP sk
ran = (RND-0.5)*max*sk
oLd = (Lv(x,y-hL) + Lv(x,y+hL))/2
Lv(x,y) = oLd + ran
NEXT y
NEXT x
Docentres:
PRINT "Centers "
FOR x = hL TO 64 STEP sk
FOR y = hL TO 64 STEP sk
ran = (RND-0.5)*max*sk
oLd1 = (Lv(x+hL,y-hL) + Lv(x-hL,y+hL))/2
oLd2 = (Lv(x-hL,y-hL) + Lv(x+hL,y+hL))/2
oLd = (oLd1 + oLd2)/2
Lv(x,y) = oLd + ran
IF Lv(x,y) > maxLv THEN maxLv = Lv(x,y)
NEXT y
NEXT x
NEXT iter
snowLine = maxLv - maxLv/4
drawmount:
CLS
xm = 4
ym = 1
xshift = 0.5
yp = 70
FOR x = 0 TO 64
IF Lv(x,0) < 0 THEN Lv(x,0) = 0
NEXT x
FOR y = 0 TO 63
IF Lv(0,y) < 0 THEN Lv(0,y) = 0
FOR x = 0 TO 63
IF Lv(x+1,y+1) < 0 THEN Lv(x+1,y+1) = 0
Lv = Lv(x,y) + Lv(x+1,y) + Lv(x,y+1)
Lv = (Lv + Lv(x+1,y+1))/4
a=x:b=y
rx1 = xm * a + xshift * b
ry1 = ym * b + yp - Lv(a,b)
GOSUB getshade:
shade1 = shade
a = x + 1
rx2 = xm * a + xshift * b
ry2 = ym * b + yp - Lv(a,b)
GOSUB getshade:
shade2 = shade
a = x:b = y + 1
rx3 = xm * a + xshift * b
ry3 = ym * b +yp - Lv(a,b)
GOSUB getshade:
shade3 = shade
a = x + 1
rx4 = xm * a + xshift * b
ry4 = ym * b + yp - Lv(a,b)
GOSUB getshade:
shade4 = shade
a = x + 0.5:b = y + 0.5
rx = xm * a + xshift * b
ry = ym * b + yp
a=x:b=y
ry = ry - Lv
AREA (rx,ry)
AREA (rx1,ry1)
AREA (rx2,ry2)
COLOR shade1
AREAFILL
AREA (rx,ry)
AREA (rx4,ry4)
COLOR shade2
AREAFILL
AREA (rx,ry)
AREA (rx1,ry1)
AREA (rx3,ry3)
COLOR shade3
AREAFILL
AREA (rx,ry)
AREA (rx3,ry3)
AREA (rx4,ry4)
COLOR shade4
AREAFILL
NEXT x
NEXT y
ender:
a$ = INKEY$
IF a$ = "s" THEN GOTO savepic
IF a$ <> " " THEN GOTO ender
end2:
WINDOW CLOSE 3
SCREEN CLOSE 2
WINDOW OUTPUT 1
END
getshade:
c = x + 1 - (b-y)
d = y + (a-x)
xc = x + 0.5
yc = y + 0.5
xrun1 = xc - a
xrun2 = xc - c
yrun1 = yc - b
yrun2 = yc - d
rise1 = Lv - Lv(a,b)
rise2 = Lv - Lv(c,d)
yrise = ABS(rise1*xrun2 - rise2*xrun1)
yrun = ABS(yrun1*xrun2 - xrun1*yrun2)
IF yrun = yrise THEN yrun = 1:yrise = 1
xrise = ABS(rise1*yrun2 - rise2*yrun1)
xrun = ABS(xrun1*yrun2 - yrun1*xrun2)
IF xrun = xrise THEN xrun = 1:xrise = 1
xrise = xrise / 2
yrise = yrise / 2
xshade = 1-ABS(xrise / (xrun + xrise))
yshade = 1-ABS(yrise / (yrun + yrise))
shade = 14*xshade*yshade+1
IF Lv > snowLine THEN shade = shade + 16
IF Lv <= 0 THEN shade = 16
RETURN
savepic:
rastport& = WINDOW(8)
bitmap& = PEEKL(rastport&+4)
topLine = 60 - INT(maxLv)
IF topLine < 0 THEN topLine = 0
topadd = topLine * 40
FOR a = 0 TO 4
pLane&(a) = PEEKL(bitmap& + 8 + a*4)+topadd
NEXT
bottomLine = 144
Lines = bottomLine - topLine
OPEN fiL$ FOR OUTPUT AS 1
a$ = MKL$(Lines * 40 * 5 + 144)
PRINT#1,"FORM";a$;"ILBMBMHD";MKL$(20);
PRINT#1,MKI$(320);MKI$(Lines);MKL$(0);
PRINT#1,CHR$(5);MKI$(0);CHR$(0);
PRINT#1,MKI$(0);CHR$(10);CHR$(11);
PRINT#1,MKI$(320);MKI$(200);
PRINT#1,"CMAP";MKL$(96);
FOR a = 0 TO 31
PRINT#1,cmap$(a);
NEXT
PRINT#1,"BODY";MKL$(Lines * 40 * 5);
FOR a = 1 TO Lines
FOR p = 0 TO 4
FOR b = 0 TO 39 STEP 4
PRINT#1,MKL$(PEEKL(pLane&(p) + b));
NEXT b
POKEL pLane&(p), -1
pLane&(p) = pLane&(p) + 40
NEXT p
NEXT a
CLOSE
GOTO end2